home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tprint.zip / TESTPRN2.PAS < prev   
Pascal/Delphi Source File  |  1991-05-10  |  2KB  |  95 lines

  1. PROGRAM TestPrn;
  2. {$F+}
  3. {-- Sample program using the printer unit --}
  4.  
  5. Uses wObjects,winProcs,repPrn,stdDlgs,WinTypes,Strings;
  6. const
  7.   cmSetPrint = 1;
  8.   cmPrintFile = 2;
  9.  
  10. TYPE
  11.   tTestApp = object(tApplication)
  12.     procedure InitMainWindow; virtual;
  13.   end;
  14.  
  15.   pPrnWindow = ^tPrnWindow;
  16.   tPrnWindow = object(tWindow)
  17.     aPrinter: pReportPrinter;
  18.     constructor Init(aParent: pWindowsObject;aTitle: pChar);
  19.     procedure   setPrinter(var msg:tMessage);virtual cm_first + cmSetPrint;
  20.     procedure   filePrint(var msg: tMessage);virtual cm_first + cmPrintFile;
  21.   end;
  22.   pathStr = array[0..64] of Char;
  23.  
  24.  
  25. {$R test.res}
  26.  
  27. procedure tPrnWindow.setPrinter(var msg:tMessage);
  28. begin
  29.   aPrinter := new(preportPrinter,Init(hInstance,@self,10));
  30.   aPrinter^.prnDeviceMode(hWindow);
  31.   dispose(aPrinter,Done);
  32. End;
  33.  
  34. Function fileIsOpen(var t: Text;f: pathStr): Boolean;
  35. var
  36.   ioCode: integer;
  37. Begin
  38. {$I-}
  39.   assign(t,f);
  40.   reset(t);
  41.   ioCode := ioResult;
  42.   fileIsOpen := (ioCode = 0);
  43. {$I+}
  44. end;
  45.  
  46. procedure tPrnWindow.filePrint(var msg: tMessage);
  47. {-- Gets a file name from the user, and prints it out. (the file, not
  48.     the file name --}
  49. var
  50.   fName: pathStr;
  51.   textFile: Text;
  52.   tLine: array[0..79] of char;
  53.  
  54. Begin
  55.   fName[0] := ' ';
  56.   if (Application^.ExecDialog(new(pInputDialog,Init(@self,'File to Print',
  57.          'Enter File Name: ',@fName,SizeOf(fName)))) = id_OK) then begin
  58.     if (FileIsOpen(textFile,fName)) then begin
  59.  
  60.       aPrinter := new(pReportPrinter,Init(hInstance,@self,60));          {init the printer object}
  61.       aPrinter^.setDefaults('Heading');
  62.       if aPrinter^.Start('PrnTest',hWindow) then begin  {start the printer}
  63.         while not eof(textFile) do begin
  64.           readln(textFile,tLine);
  65.           aPrinter^.outText(@tLine);     {send each line to the printer object}
  66.         End;
  67.         close(textFile);
  68.         aPrinter^.Finish;                {finish the print job}
  69.         dispose(aPrinter,Done);
  70.       End;
  71.     End;
  72.   End;
  73. end;
  74.  
  75. constructor tPrnWindow.Init(aParent: pWindowsObject;aTitle: pChar);
  76. begin
  77.   tWindow.Init(aParent,aTitle);
  78.   Attr.Style := WS_OverlappedWindow or ws_Vscroll or WS_Hscroll;
  79.   attr.Menu := loadMenu(hInstance,pChar(100));
  80. end;
  81.  
  82. Procedure tTestApp.InitMainWindow;
  83. Begin
  84.   MainWindow := new(pPrnWindow,init(nil,'Printer Test'));
  85. End;
  86.  
  87.  
  88. var
  89.   tApp: tTestApp;
  90.  
  91. Begin
  92.   tApp.Init('Printer Test');
  93.   tApp.Run;
  94.   tApp.Done;
  95. End.